home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 July / macformat-026.iso / mac / Shareware City / Developers / berkeleydb1.73 / Berkeley_db / Distribute < prev    next >
Encoding:
Text File  |  1993-07-31  |  2.1 KB  |  100 lines  |  [TEXT/MPS ]
  1. Set DistFolder `Perl -Sx "{0}" "{1}" "{TempFolder}"Distribute.Dup`     &&    ∂
  2.     "{TempFolder}"Distribute.Dup                                                    &&    ∂
  3.     Stuff -r "{DistFolder}" -o "{2}"                                                &&    ∂
  4.     Delete -y "{DistFolder}" "{TempFolder}"Distribute.Dup
  5. Exit
  6.  
  7. #!perl
  8. #######################################################################
  9. #    Project    :    Distr                -    
  10. #    File        :    Distribute        -    Build a distribution
  11. #    Author    :    Matthias Neeracher
  12. #    Started    :    29Jun93                                Language    :    MPW Perl
  13. #    Modified    :    31Jul93    MN    Some unpleasant bugs
  14. #    Last        :    31Jul93
  15. #######################################################################
  16.  
  17. ($distfile,$dup) = @ARGV;
  18.  
  19. open(DIST, $distfile) || die "$0: Could not open \"$distfile\"";
  20. open(DUP, ">$dup") || die "$0: Could not open \"$dup\"";
  21.  
  22. while (<DIST>) {
  23.     next if /^\s*$/;
  24.     next if /^\s*#/;
  25.     
  26.     if (/^\s*TARGET\s+(\S+)\s*$/) {
  27.         $target = $1;
  28.         
  29.         $target = ":$target" unless ($target =~ /^:/);
  30.         $target = "$target:" unless ($target =~ /:$/);
  31.             
  32.         &mkdirs($target);
  33.     } elsif (/^\s*(\S+)\s+AS\s+(\S+)\s*$/) {
  34.         &linkfile($1, "$target$2", 0);
  35.     } elsif (/^\s*(\S+)\s*$/) {
  36.         &linkfiles($1, $target);
  37.     } else {
  38.         print STDERR "File \"$distfile\"; Line $. # Syntax Error\n";
  39.     }
  40. }
  41.  
  42. $target =~ /^:?([^:]+)/;
  43.  
  44. print "$1\n";
  45.  
  46. sub mkdirs 
  47. {
  48.     local($dir) = @_;
  49.     
  50.     if (!-d $dir) {
  51.         if ($dir =~ /(.*:)[^:]+:/) {
  52.             &mkdirs($1);
  53.         }
  54.         
  55.         mkdir($dir, 0777) || die "Couldn't create directory \"$dir\"";
  56.     }
  57. }
  58.  
  59. sub linkfile
  60. {
  61.     local($from,$to,$linkem) = @_;
  62.     
  63.     print STDERR "\t\t\t$from -> $to\n";
  64.     
  65.     unlink $to if (-e $to);
  66.     
  67.     if ($linkem) {
  68.         symlink($from, $to) || die "Couldn't link \"$from\" to \"$to\"";
  69.     } else {
  70.         print DUP "Duplicate \'$from\' \'$to\'\n";
  71.     }
  72. }
  73.  
  74. sub linkfiles
  75. {
  76.     local($from,$target) = @_;
  77.     
  78.     if ($from =~ /^(.*):([^:]+)$/) {
  79.         ($fromdir,$fromfile) = ($1,$2);
  80.     } else {
  81.         ($fromdir,$fromfile) = (":",$from);
  82.     }
  83.     
  84.     if ($fromfile =~ /[≈?]/) {
  85.         $fromfile =~ s/\./\\./;
  86.         $fromfile =~ s/≈/.*/;
  87.         $fromfile =~ s/\?/./;
  88.         
  89.         opendir(FROMDIR, $fromdir) || "Could not open \"$fromdir\"";
  90.         
  91.         while ($from = readdir(FROMDIR)) {
  92.             next unless $from =~ /^$fromfile$/;
  93.             
  94.             &linkfile("$fromdir:$from", "$target$from", 1);
  95.         }
  96.     } else {
  97.         &linkfile($from,"$target$fromfile", 1);
  98.     }
  99. }
  100.